home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0088_Better Julia Set.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  2KB  |  76 lines
  1. {
  2. >   Thanks for writing a working Pascal source.  Hopefully it will
  3. >   work with 640x480 resolution (320x200 is a bit grainy, specieally
  4. >   with the default palette.)
  5.  
  6. I changed Norbert's source a little. Now it looks nicer, and I believe it's
  7. even a fraction faster (not sure, though, didn't time it):
  8. }
  9.  
  10. {$G+,N+,E-} { if you have no CoPro, set E+ }
  11.  
  12. { Reals   Complex
  13.    -1        0
  14.    -0.1      0.8
  15.     0.3     -0.5
  16.    -1.139    0.238
  17. }
  18.  
  19. program Julia;
  20. const Gseg : word = $a000;
  21. Type real = double;
  22. var Cx,Cy,Xo,Yo,X1,Y1 : real; Mx,My,A,B,I,Orb : word;
  23.  
  24. procedure Pset(X,Y : word; C : byte); assembler;
  25. asm
  26.   mov es,Gseg
  27.   mov ax,[Y]
  28.   shl ax,6
  29.   mov di,ax
  30.   shl ax,2
  31.   add di,ax
  32.   add di,[X]
  33.   mov al,[C]
  34.   mov [es:di],al
  35. end;
  36.  
  37. function keypressed : boolean; assembler; asm
  38.   mov ah,0bh; int 21h; and al,0feh; end;
  39.  
  40. procedure Setpalette;
  41. var I : byte;
  42. begin
  43.   for I := 1 to 64 do begin
  44.     port[$3c8] := I;
  45.     port[$3c9] := 10+I div 3;
  46.     port[$3c9] := 10+I div 3;
  47.     port[$3c9] := 15+round(I/1.306122449);
  48.   end;
  49. end;
  50.  
  51. begin
  52.   write('Real part: '); readln(Cx);
  53.   write('Imaginary part: '); readln(Cy);
  54.   asm mov ax,13h; int 10h; end;
  55.   Setpalette;
  56.   Mx := 319; My := 199;
  57.   for A := 1 to Mx  do
  58.     for B := 1 to My do begin
  59.       Xo := -2+A/(Mx/4); { X complex plane coordinate }
  60.       Yo :=  2-B/(My/4); { Y complex plane coordinate }
  61.       Orb := 0; I := 0;
  62.       repeat
  63.         X1 := Xo*Xo-Yo*Yo+Cx;
  64.         Y1 := 2*Xo*Yo+Cy;
  65.         Xo := X1;
  66.         Yo := Y1;
  67.         inc(I);
  68.       until (I = 64) or (X1*X1+Y1*Y1 > 4);
  69.       if I <> 64 then Orb := I;
  70.       Pset(A,B,Orb); { Plot orbit }
  71.     end;
  72.   while not keypressed do;
  73.   asm mov ax,3; int 10h; end;
  74. end.
  75.  
  76.